home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / fndnam.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  6KB  |  204 lines
  1. /* fndnam.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal value[200000];
  40. } blank_;
  41.  
  42. #define blank_1 blank_
  43.  
  44. struct {
  45.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  46.         sfactr;
  47.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  48.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  49. } status_;
  50.  
  51. #define status_1 status_
  52.  
  53. /* Table of constant values */
  54.  
  55. static integer c__1 = 1;
  56.  
  57. /*<       subroutine fndnam(anam,jsbptr,ispot,id) >*/
  58. /* Subroutine */ int fndnam_(anam, jsbptr, ispot, id)
  59. doublereal *anam;
  60. integer *jsbptr, *ispot, *id;
  61. {
  62.     /* Format strings */
  63.     static char fmt_91[] = "(\0020*error*:  unable to find \002,a8/)";
  64.  
  65.     /* Builtin functions */
  66.     integer s_wsfe(), do_fio(), e_wsfe();
  67.  
  68.     /* Local variables */
  69.     static integer isub, locv;
  70.     extern integer xxor_();
  71. #define nodplc ((integer *)&blank_1)
  72. #define cvalue ((complex *)&blank_1)
  73.     static integer isbptr, loc;
  74.  
  75.     /* Fortran I/O blocks */
  76.     static cilist io__7 = { 0, 0, 0, fmt_91, 0 };
  77.  
  78.  
  79. /*<       implicit double precision (a-h,o-z) >*/
  80.  
  81. /*     this routine searches for an element with id 'id' by tracing back 
  82. */
  83. /* up the subcircuit definition list.  if the element is not found, the */
  84.  
  85. /* nominal element list is searched. */
  86.  
  87. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  88. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  89. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  90. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  91. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  92. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  93. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  94. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  95. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  96. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  97. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  98. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  99. /* spice version 2g.6  sccsid=flags 3/15/83 */
  100. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  101. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  102. /* spice version 2g.6  sccsid=blank 3/15/83 */
  103. /*<       common /blank/ value(200000) >*/
  104. /* spice version 2g.6  sccsid=status 3/15/83 */
  105. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  106. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  107. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  108. /*<       integer nodplc(64) >*/
  109. /*<       complex cvalue(32) >*/
  110. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  111. /*<       integer xxor >*/
  112.  
  113.  
  114. /*<       isbptr=nodplc(jsbptr) >*/
  115.     isbptr = nodplc[*jsbptr - 1];
  116. /*<    10 if (isbptr.eq.0) go to 50 >*/
  117. L10:
  118.     if (isbptr == 0) {
  119.     goto L50;
  120.     }
  121. /*<       isub=nodplc(isbptr+3) >*/
  122.     isub = nodplc[isbptr + 2];
  123. /*<       loc=nodplc(isub+3) >*/
  124.     loc = nodplc[isub + 2];
  125. /*<    20 if (loc.eq.0) go to 40 >*/
  126. L20:
  127.     if (loc == 0) {
  128.     goto L40;
  129.     }
  130. /*<       if (id.ne.nodplc(loc-1)) go to 30 >*/
  131.     if (*id != nodplc[loc - 2]) {
  132.     goto L30;
  133.     }
  134. /*<       locv=nodplc(loc+1) >*/
  135.     locv = nodplc[loc];
  136. /*<       if (xxor(anam,value(locv)).ne.0) go to 30 >*/
  137.     if (xxor_(anam, &blank_1.value[locv - 1]) != 0) {
  138.     goto L30;
  139.     }
  140. /*<       if (id.ne.20) go to 50 >*/
  141.     if (*id != 20) {
  142.     goto L50;
  143.     }
  144. /*<       go to 65 >*/
  145.     goto L65;
  146. /*<    30 loc=nodplc(loc) >*/
  147. L30:
  148.     loc = nodplc[loc - 1];
  149. /*<       go to 20 >*/
  150.     goto L20;
  151. /*<    40 isbptr=nodplc(isbptr-1) >*/
  152. L40:
  153.     isbptr = nodplc[isbptr - 2];
  154. /*<       go to 10 >*/
  155.     goto L10;
  156.  
  157. /*<    50 loc=locate(id) >*/
  158. L50:
  159.     loc = cirdat_1.locate[*id - 1];
  160. /*<    60 if (loc.eq.0) go to 90 >*/
  161. L60:
  162.     if (loc == 0) {
  163.     goto L90;
  164.     }
  165. /*<       if (nodplc(loc-1).ne.isbptr) go to 70 >*/
  166.     if (nodplc[loc - 2] != isbptr) {
  167.     goto L70;
  168.     }
  169. /*<       locv=nodplc(loc+1) >*/
  170.     locv = nodplc[loc];
  171. /*<       if (xxor(anam,value(locv)).ne.0) go to 70 >*/
  172.     if (xxor_(anam, &blank_1.value[locv - 1]) != 0) {
  173.     goto L70;
  174.     }
  175. /*<    65 nodplc(ispot)=loc >*/
  176. L65:
  177.     nodplc[*ispot - 1] = loc;
  178. /*<       go to 100 >*/
  179.     goto L100;
  180. /*<    70 loc=nodplc(loc) >*/
  181. L70:
  182.     loc = nodplc[loc - 1];
  183. /*<       go to 60 >*/
  184.     goto L60;
  185. /*<    90 write (iofile,91) anam >*/
  186. L90:
  187.     io__7.ciunit = status_1.iofile;
  188.     s_wsfe(&io__7);
  189.     do_fio(&c__1, (char *)&(*anam), (ftnlen)sizeof(doublereal));
  190.     e_wsfe();
  191. /*<    91 format('0*error*:  unable to find ',a8/) >*/
  192. /*<       nogo=1 >*/
  193.     flags_1.nogo = 1;
  194. /*<   100 return >*/
  195. L100:
  196.     return 0;
  197. /*<       end >*/
  198. } /* fndnam_ */
  199.  
  200. #undef cvalue
  201. #undef nodplc
  202.  
  203.  
  204.